Usenet 1993 July/InfoMagic USENET CD-ROM July 1993.ISO/sources/unix/volume13/ratfor

Internet Message Format | 1988-02-27 | 53.4 KB

Subject:  v13i037:  Public domain RATFOR in C
Newsgroups: comp.sources.unix
Sender: sources
Approved: [e-mail]

Submitted-by: Ozan Yigit <yunexus!oz>
Posting-number: Volume 13, Issue 37
Archive-name: ratfor

[  This is a pre-processor that turns RATFOR programs in to real Fortran
   programs.  RATFOR is Fortran with real control structures, like
   switch and if/then/else.  This happens to generate F77 Fortran, too.
   --r$  ]

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    rat4.c
#    lookup.c
#    getopt.c
#    ratdef.h
#    ratcom.h
#    lookup.h
#    README
#    ratfor.doc
#    test.r
#    makefile
export PATH; PATH=/bin:$PATH
echo shar: extracting "'rat4.c'" '(33966 characters)'
if test -f 'rat4.c'
then
    echo shar: will not over-write existing file "'rat4.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'rat4.c'
    X/*
    X * ratfor - A ratfor pre-processor in C.
    X * Derived from a pre-processor distributed by the
    X * University of Arizona. Closely corresponds to the
    X * pre-processor described in the "SOFTWARE TOOLS" book.
    X *
    X * By: oz
    X *
    X * Not deived from AT&T code.
    X *
    X * This code is in the public domain. In other words, all rights
    X * are granted to all recipients, "public" at large.
    X *
    X * Modification history:
    X *
    X * June 1985
    X *    - Ken Yap's mods for F77 output. Currently
    X *      available thru #define F77.
    X *    - Two minor bug-fixes for sane output.
    X * June 1985
    X *    - Improve front-end with getopt().
    X *      User may specify -l n for starting label.
    X *    - Retrofit switch statement handling. This code
    X *      is borrowed from the SWTOOLS Ratfor.
    X *
    X */
    X
    X#include <stdio.h>
    X#include "ratdef.h"
    X#include "ratcom.h"
    X
    X/* keywords: */
    X
    Xchar sdo[3] = {
    X    LETD,LETO,EOS};
    Xchar vdo[2] = {
    X    LEXDO,EOS};
    X
    Xchar sif[3] = {
    X    LETI,LETF,EOS};
    Xchar vif[2] = {
    X    LEXIF,EOS};
    X
    Xchar selse[5] = {
    X    LETE,LETL,LETS,LETE,EOS};
    Xchar velse[2] = {
    X    LEXELSE,EOS};
    X
    X#ifdef F77
    Xchar sthen[5] = {
    X    LETT,LETH,LETE,LETN,EOS};
    X
    Xchar sendif[6] = {
    X    LETE,LETN,LETD,LETI,LETF,EOS};
    X
    X#endif F77
    Xchar swhile[6] = {
    X    LETW, LETH, LETI, LETL, LETE, EOS};
    Xchar vwhile[2] = {
    X    LEXWHILE, EOS};
    X
    Xchar sbreak[6] = {
    X    LETB, LETR, LETE, LETA, LETK, EOS};
    Xchar vbreak[2] = {
    X    LEXBREAK, EOS};
    X
    Xchar snext[5] = {
    X    LETN,LETE, LETX, LETT, EOS};
    Xchar vnext[2] = {
    X    LEXNEXT, EOS};
    X
    Xchar sfor[4] = {
    X    LETF,LETO, LETR, EOS};
    Xchar vfor[2] = {
    X    LEXFOR, EOS};
    X
    Xchar srept[7] = {
    X    LETR, LETE, LETP, LETE, LETA, LETT, EOS};
    Xchar vrept[2] = {
    X    LEXREPEAT, EOS};
    X
    Xchar suntil[6] = {
    X    LETU, LETN, LETT, LETI, LETL, EOS};
    Xchar vuntil[2] = {
    X    LEXUNTIL, EOS};
    X
    Xchar sswitch[7] = {
    X    LETS, LETW, LETI, LETT, LETC, LETH, EOS};
    Xchar vswitch[2] = {
    X    LEXSWITCH, EOS};
    X
    Xchar scase[5] = {
    X    LETC, LETA, LETS, LETE, EOS};
    Xchar vcase[2] = {
    X    LEXCASE, EOS};
    X
    Xchar sdefault[8] = {
    X    LETD, LETE, LETF, LETA, LETU, LETL, LETT, EOS};
    Xchar vdefault[2] = {
    X    LEXDEFAULT, EOS};
    X
    Xchar sret[7] = {
    X    LETR, LETE, LETT, LETU, LETR, LETN, EOS};
    Xchar vret[2] = {
    X    LEXRETURN, EOS};
    X
    Xchar sstr[7] = {
    X    LETS, LETT, LETR, LETI, LETN, LETG, EOS};
    Xchar vstr[2] = {
    X    LEXSTRING, EOS};
    X
    Xchar deftyp[2] = {
    X    DEFTYPE, EOS};
    X
    X/* constant strings */
    X
    Xchar *errmsg = "error at line ";
    Xchar *in     = " in ";
    Xchar *ifnot  = "if(.not.";
    Xchar *incl   = "include";
    Xchar *fncn   = "function";
    Xchar *def    = "define";
    Xchar *bdef   = "DEFINE";
    Xchar *contin = "continue";
    Xchar *rgoto  = "goto ";
    Xchar *dat    = "data ";
    Xchar *eoss   = "EOS/";
    X
    Xextern char ngetch();
    Xchar *progname;
    Xint startlab = 23000;        /* default start label */
    X
    X/*
    X * M A I N   L I N E  &  I N I T
    X */
    X
    Xmain(argc,argv)
    Xint argc;
    Xchar *argv[];
    X{
    X    int c, errflg = 0;
    X    extern int optind;
    X    extern char *optarg;
    X
    X    progname = argv[0];
    X
    X    while ((c=getopt(argc, argv, "Chn:o:6:")) != EOF)
    X    switch (c) {
    X        case 'C':
    X                /* not written yet */
    X            break;
    X        case 'h':
    X                /* not written yet */
    X            break;
    X        case 'l':    /* user sets label */
    X            startlab = atoi(optarg);
    X            break;
    X        case 'o':
    X            if ((freopen(optarg, "w", stdout)) == NULL)
    X                error("can't write %s\n", optarg);
    X            break;
    X        case '6':
    X                /* not written yet */
    X            break;
    X        default:
    X            ++errflg;
    X    }
    X
    X    if (errflg) {
    X        fprintf(stderr,
    X            "usage: %s [-C][-hx][-l n][-o file][-6x] [file...]\n");
    X        exit(1);
    X    }
    X
    X    /*
    X     * present version can only process one file, sadly.
    X     */
    X    if (optind >= argc)
    X        infile[0] = stdin;
    X    else if ((infile[0] = fopen(argv[optind], "r")) == NULL)
    X        error("cannot read %s\n", argv[optind]);
    X
    X    initvars();
    X
    X    parse();        /* call parser.. */
    X
    X    exit(1);
    X}
    X
    X/*
    X * initialise
    X */
    Xinitvars()
    X{
    X    int i;
    X
    X    outp = 0;        /* output character pointer */
    X    level = 0;        /* file control */
    X    linect[0] = 1;        /* line count of first file */
    X    fnamp = 0;
    X    fnames[0] = EOS;
    X    bp = -1;        /* pushback buffer pointer */
    X    fordep = 0;        /* for stack */
    X    swtop = 0;        /* switch stack index */
    X    swlast = 1;        /* switch stack index */
    X    for( i = 0; i <= 126; i++)
    X        tabptr[i] = 0;
    X    install(def, deftyp);    /* default definitions */
    X    install(bdef, deftyp);
    X    fcname[0] = EOS;    /* current function name */
    X    label = startlab;    /* next generated label */
    X}
    X
    X/*
    X * P A R S E R
    X */
    X
    Xparse()
    X{
    X    char lexstr[MAXTOK];
    X    int lab, labval[MAXSTACK], lextyp[MAXSTACK], sp, i, token;
    X
    X    sp = 0;
    X    lextyp[0] = EOF;
    X    for (token = lex(lexstr); token != EOF; token = lex(lexstr)) {
    X        if (token == LEXIF)
    X            ifcode(&lab);
    X        else if (token == LEXDO)
    X            docode(&lab);
    X        else if (token == LEXWHILE)
    X            whilec(&lab);
    X        else if (token == LEXFOR)
    X            forcod(&lab);
    X        else if (token == LEXREPEAT)
    X            repcod(&lab);
    X        else if (token == LEXSWITCH)
    X            swcode(&lab);
    X        else if (token == LEXCASE || token == LEXDEFAULT) {
    X            for (i = sp; i >= 0; i--)
    X                if (lextyp[i] == LEXSWITCH)
    X                    break;
    X            if (i < 0)
    X                synerr("illegal case of default.");
    X            else
    X                cascod(labval[i], token);
    X        }
    X        else if (token == LEXDIGITS)
    X            labelc(lexstr);
    X        else if (token == LEXELSE) {
    X            if (lextyp[sp] == LEXIF)
    X                elseif(labval[sp]);
    X            else
    X                synerr("illegal else.");
    X        }
    X        if (token == LEXIF || token == LEXELSE || token == LEXWHILE
    X            || token == LEXFOR || token == LEXREPEAT
    X            || token == LEXDO || token == LEXDIGITS
    X            || token == LEXSWITCH || token == LBRACE) {
    X            sp++;         /* beginning of statement */
    X            if (sp > MAXSTACK)
    X                baderr("stack overflow in parser.");
    X            lextyp[sp] = token;     /* stack type and value */
    X            labval[sp] = lab;
    X        }
    X        else if (token != LEXCASE && token != LEXDEFAULT) {
    X            /*
    X                 * end of statement - prepare to unstack
    X             */
    X            if (token == RBRACE) {
    X                if (lextyp[sp] == LBRACE)
    X                    sp--;
    X                else if (lextyp[sp] == LEXSWITCH) {
    X                    swend(labval[sp]);
    X                    sp--;
    X                }
    X                else
    X                    synerr("illegal right brace.");
    X            }
    X            else if (token == LEXOTHER)
    X                otherc(lexstr);
    X            else if (token == LEXBREAK || token == LEXNEXT)
    X                brknxt(sp, lextyp, labval, token);
    X            else if (token == LEXRETURN)
    X                retcod();
    X             else if (token == LEXSTRING)
    X                strdcl();
    X            token = lex(lexstr);      /* peek at next token */
    X            pbstr(lexstr);
    X            unstak(&sp, lextyp, labval, token);
    X        }
    X    }
    X    if (sp != 0)
    X        synerr("unexpected EOF.");
    X}
    X
    X/*
    X * L E X I C A L  A N A L Y S E R
    X */
    X
    X/*
    X *  alldig - return YES if str is all digits
    X *
    X */
    Xint
    Xalldig(str)
    Xchar str[];
    X{
    X    int i,j;
    X
    X    j = NO;
    X    if (str[0] == EOS)
    X        return(j);
    X    for (i = 0; str[i] != EOS; i++)
    X        if (type(str[i]) != DIGIT)
    X            return(j);
    X    j = YES;
    X    return(j);
    X}
    X
    X
    X/*
    X * balpar - copy balanced paren string
    X *
    X */
    Xbalpar()
    X{
    X    char token[MAXTOK];
    X    int t,nlpar;
    X
    X    if (gnbtok(token, MAXTOK) != LPAREN) {
    X        synerr("missing left paren.");
    X        return;
    X    }
    X    outstr(token);
    X    nlpar = 1;
    X    do {
    X        t = gettok(token, MAXTOK);
    X        if (t==SEMICOL || t==LBRACE || t==RBRACE || t==EOF) {
    X            pbstr(token);
    X            break;
    X        }
    X        if (t == NEWLINE)      /* delete newlines */
    X            token[0] = EOS;
    X        else if (t == LPAREN)
    X            nlpar++;
    X        else if (t == RPAREN)
    X            nlpar--;
    X        /* else nothing special */
    X        outstr(token);
    X    }
    X    while (nlpar > 0);
    X    if (nlpar != 0)
    X        synerr("missing parenthesis in condition.");
    X}
    X
    X/*
    X * deftok - get token; process macro calls and invocations
    X *
    X */
    Xint
    Xdeftok(token, toksiz, fd)
    Xchar token[];
    Xint toksiz;
    XFILE *fd;
    X{
    X    char defn[MAXDEF];
    X    int t;
    X
    X    for (t=gtok(token, toksiz, fd); t!=EOF; t=gtok(token, toksiz, fd)) {
    X        if (t != ALPHA)   /* non-alpha */
    X            break;
    X        if (look(token, defn) == NO)   /* undefined */
    X            break;
    X        if (defn[0] == DEFTYPE) {   /* get definition */
    X            getdef(token, toksiz, defn, MAXDEF, fd);
    X            install(token, defn);
    X        }
    X        else
    X            pbstr(defn);   /* push replacement onto input */
    X    }
    X    if (t == ALPHA)   /* convert to single case */
    X        fold(token);
    X    return(t);
    X}
    X
    X
    X/*
    X * eatup - process rest of statement; interpret continuations
    X *
    X */
    Xeatup()
    X{
    X
    X    char ptoken[MAXTOK], token[MAXTOK];
    X    int nlpar, t;
    X
    X    nlpar = 0;
    X    do {
    X        t = gettok(token, MAXTOK);
    X        if (t == SEMICOL || t == NEWLINE)
    X            break;
    X        if (t == RBRACE || t == LBRACE) {
    X            pbstr(token);
    X            break;
    X        }
    X        if (t == EOF) {
    X            synerr("unexpected EOF.");
    X            pbstr(token);
    X            break;
    X        }
    X        if (t == COMMA || t == PLUS
    X                   || t == MINUS || t == STAR || t == LPAREN
    X                       || t == AND || t == BAR || t == BANG
    X                   || t == EQUALS || t == UNDERLINE ) {
    X            while (gettok(ptoken, MAXTOK) == NEWLINE)
    X                ;
    X            pbstr(ptoken);
    X            if (t == UNDERLINE)
    X                token[0] = EOS;
    X        }
    X        if (t == LPAREN)
    X            nlpar++;
    X        else if (t == RPAREN)
    X            nlpar--;
    X        outstr(token);
    X
    X    } while (nlpar >= 0);
    X
    X    if (nlpar != 0)
    X        synerr("unbalanced parentheses.");
    X}
    X
    X/*
    X * getdef (for no arguments) - get name and definition
    X *
    X */
    Xgetdef(token, toksiz, defn, defsiz, fd)
    Xchar token[];
    Xint toksiz;
    Xchar defn[];
    Xint defsiz;
    XFILE *fd;
    X{
    X    int i, nlpar, t;
    X    char c, ptoken[MAXTOK];
    X
    X    skpblk(fd);
    X    /*
    X     * define(name,defn) or
    X     * define name defn
    X     *
    X     */
    X    if ((t = gtok(ptoken, MAXTOK, fd)) != LPAREN) {;
    X        t = BLANK;              /* define name defn */
    X        pbstr(ptoken);
    X    }
    X    skpblk(fd);
    X    if (gtok(token, toksiz, fd) != ALPHA)
    X        baderr("non-alphanumeric name.");
    X    skpblk(fd);
    X    c = (char) gtok(ptoken, MAXTOK, fd);
    X    if (t == BLANK) {         /* define name defn */
    X        pbstr(ptoken);
    X        i = 0;
    X        do {
    X            c = ngetch(&c, fd);
    X            if (i > defsiz)
    X                baderr("definition too long.");
    X            defn[i++] = c;
    X        }
    X        while (c != SHARP && c != NEWLINE && c != EOF);
    X        if (c == SHARP)
    X            putbak(c);
    X    }
    X    else if (t == LPAREN) {   /* define (name, defn) */
    X        if (c != COMMA)
    X            baderr("missing comma in define.");
    X        /* else got (name, */
    X        nlpar = 0;
    X        for (i = 0; nlpar >= 0; i++)
    X            if (i > defsiz)
    X                baderr("definition too long.");
    X            else if (ngetch(&defn[i], fd) == EOF)
    X                baderr("missing right paren.");
    X            else if (defn[i] == LPAREN)
    X                nlpar++;
    X            else if (defn[i] == RPAREN)
    X                nlpar--;
    X        /* else normal character in defn[i] */
    X    }
    X    else
    X        baderr("getdef is confused.");
    X    defn[i-1] = EOS;
    X}
    X
    X/*
    X * gettok - get token. handles file inclusion and line numbers
    X *
    X */
    Xint
    Xgettok(token, toksiz)
    Xchar token[];
    Xint toksiz;
    X{
    X    int t, i;
    X    int tok;
    X    char name[MAXNAME];
    X
    X    for ( ; level >= 0; level--) {
    X        for (tok = deftok(token, toksiz, infile[level]); tok != EOF;
    X             tok = deftok(token, toksiz, infile[level])) {
    X                if (equal(token, fncn) == YES) {
    X                skpblk(infile[level]);
    X                t = deftok(fcname, MAXNAME, infile[level]);
    X                pbstr(fcname);
    X                if (t != ALPHA)
    X                    synerr("missing function name.");
    X                putbak(BLANK);
    X                return(tok);
    X            }
    X            else if (equal(token, incl) == NO)
    X                return(tok);
    X            for (i = 0 ;; i = strlen(name)) {
    X                t = deftok(&name[i], MAXNAME, infile[level]);
    X                if (t == NEWLINE || t == SEMICOL) {
    X                    pbstr(&name[i]);
    X                    break;
    X                }
    X            }
    X            name[i] = EOS;
    X            if (name[1] == SQUOTE) {
    X                outtab();
    X                outstr(token);
    X                outstr(name);
    X                outdon();
    X                eatup();
    X                return(tok);
    X            }
    X            if (level >= NFILES)
    X                synerr("includes nested too deeply.");
    X            else {
    X                infile[level+1] = fopen(name, "r");
    X                linect[level+1] = 1;
    X                if (infile[level+1] == NULL)
    X                    synerr("can't open include.");
    X                else {
    X                    level++;
    X                    if (fnamp + i <= MAXFNAMES) {
    X                        scopy(name, 0, fnames, fnamp);
    X                        fnamp = fnamp + i;    /* push file name stack */
    X                    }
    X                }
    X            }
    X        }
    X        if (level > 0) {      /* close include and pop file name stack */
    X            fclose(infile[level]);
    X            for (fnamp--; fnamp > 0; fnamp--)
    X                if (fnames[fnamp-1] == EOS)
    X                    break;
    X        }
    X    }
    X    token[0] = EOF;   /* in case called more than once */
    X    token[1] = EOS;
    X    tok = EOF;
    X    return(tok);
    X}
    X
    X/*
    X * gnbtok - get nonblank token
    X *
    X */
    Xint
    Xgnbtok(token, toksiz)
    Xchar token[];
    Xint toksiz;
    X{
    X    int tok;
    X
    X    skpblk(infile[level]);
    X    tok = gettok(token, toksiz);
    X    return(tok);
    X}
    X
    X/*
    X * gtok - get token for Ratfor
    X *
    X */
    Xint
    Xgtok(lexstr, toksiz, fd)
    Xchar lexstr[];
    Xint toksiz;
    XFILE *fd;
    X{
    X    int i, b, n, tok;
    X    char c;
    X    c = ngetch(&lexstr[0], fd);
    X    if (c == BLANK || c == TAB) {
    X        lexstr[0] = BLANK;
    X        while (c == BLANK || c == TAB)    /* compress many blanks to one */
    X            c = ngetch(&c, fd);
    X        if (c == SHARP)
    X            while (ngetch(&c, fd) != NEWLINE)   /* strip comments */
    X                ;
    X        if (c != NEWLINE)
    X            putbak(c);
    X        else
    X            lexstr[0] = NEWLINE;
    X        lexstr[1] = EOS;
    X        return((int)lexstr[0]);
    X    }
    X    i = 0;
    X    tok = type(c);
    X    if (tok == LETTER) {    /* alpha */
    X        for (i = 0; i < toksiz - 3; i++) {
    X            tok = type(ngetch(&lexstr[i+1], fd));
    X            /* Test for DOLLAR added by BM, 7-15-80 */
    X            if (tok != LETTER && tok != DIGIT
    X                && tok != UNDERLINE && tok!=DOLLAR
    X                && tok != PERIOD)
    X                break;
    X        }
    X        putbak(lexstr[i+1]);
    X        tok = ALPHA;
    X    }
    X    else if (tok == DIGIT) {    /* digits */
    X        b = c - DIG0;    /* in case alternate base number */
    X        for (i = 0; i < toksiz - 3; i++) {
    X            if (type(ngetch(&lexstr[i+1], fd)) != DIGIT)
    X                break;
    X            b = 10*b + lexstr[i+1] - DIG0;
    X        }
    X        if (lexstr[i+1] == RADIX && b >= 2 && b <= 36) {
    X            /* n%ddd... */
    X            for (n = 0;; n = b*n + c - DIG0) {
    X                c = ngetch(&lexstr[0], fd);
    X                if (c >= LETA && c <= LETZ)
    X                    c = c - LETA + DIG9 + 1;
    X                else if (c >= BIGA && c <= BIGZ)
    X                    c = c - BIGA + DIG9 + 1;
    X                if (c < DIG0 || c >= DIG0 + b)
    X                    break;
    X            }
    X            putbak(lexstr[0]);
    X            i = itoc(n, lexstr, toksiz);
    X        }
    X        else
    X            putbak(lexstr[i+1]);
    X        tok = DIGIT;
    X    }
    X#ifdef SQUAREB
    X    else if (c == LBRACK) {   /* allow [ for { */
    X        lexstr[0] = LBRACE;
    X        tok = LBRACE;
    X    }
    X    else if (c == RBRACK) {   /* allow ] for } */
    X        lexstr[0] = RBRACE;
    X        tok = RBRACE;
    X    }
    X#endif
    X    else if (c == SQUOTE || c == DQUOTE) {
    X        for (i = 1; ngetch(&lexstr[i], fd) != lexstr[0]; i++) {
    X            if (lexstr[i] == UNDERLINE)
    X                if (ngetch(&c, fd) == NEWLINE) {
    X                    while (c == NEWLINE || c == BLANK || c == TAB)
    X                        c = ngetch(&c, fd);
    X                    lexstr[i] = c;
    X                }
    X                else
    X                    putbak(c);
    X            if (lexstr[i] == NEWLINE || i >= toksiz-1) {
    X                synerr("missing quote.");
    X                lexstr[i] = lexstr[0];
    X                putbak(NEWLINE);
    X                break;
    X            }
    X        }
    X    }
    X    else if (c == SHARP) {   /* strip comments */
    X        while (ngetch(&lexstr[0], fd) != NEWLINE)
    X            ;
    X        tok = NEWLINE;
    X    }
    X    else if (c == GREATER || c == LESS || c == NOT
    X         || c == BANG || c == CARET || c == EQUALS
    X         || c == AND || c == OR)
    X        i = relate(lexstr, fd);
    X    if (i >= toksiz-1)
    X        synerr("token too long.");
    X    lexstr[i+1] = EOS;
    X    if (lexstr[0] == NEWLINE)
    X        linect[level] = linect[level] + 1;
    X    return(tok);
    X}
    X
    X/*
    X * lex - return lexical type of token
    X *
    X */
    Xint
    Xlex(lexstr)
    Xchar lexstr[];
    X{
    X
    X    int tok;
    X
    X    for (tok = gnbtok(lexstr, MAXTOK);
    X         tok == NEWLINE; tok = gnbtok(lexstr, MAXTOK))
    X            ;
    X    if (tok == EOF || tok == SEMICOL || tok == LBRACE || tok == RBRACE)
    X        return(tok);
    X    if (tok == DIGIT)
    X        tok = LEXDIGITS;
    X    else if (equal(lexstr, sif) == YES)
    X        tok = vif[0];
    X    else if (equal(lexstr, selse) == YES)
    X        tok = velse[0];
    X    else if (equal(lexstr, swhile) == YES)
    X        tok = vwhile[0];
    X    else if (equal(lexstr, sdo) == YES)
    X        tok = vdo[0];
    X    else if (equal(lexstr, sbreak) == YES)
    X        tok = vbreak[0];
    X    else if (equal(lexstr, snext) == YES)
    X        tok = vnext[0];
    X    else if (equal(lexstr, sfor) == YES)
    X        tok = vfor[0];
    X    else if (equal(lexstr, srept) == YES)
    X        tok = vrept[0];
    X    else if (equal(lexstr, suntil) == YES)
    X        tok = vuntil[0];
    X    else if (equal(lexstr, sswitch) == YES)
    X        tok = vswitch[0];
    X    else if (equal(lexstr, scase) == YES)
    X        tok = vcase[0];
    X    else if (equal(lexstr, sdefault) == YES)
    X        tok = vdefault[0];
    X    else if (equal(lexstr, sret) == YES)
    X        tok = vret[0];
    X    else if (equal(lexstr, sstr) == YES)
    X        tok = vstr[0];
    X    else
    X        tok = LEXOTHER;
    X    return(tok);
    X}
    X
    X/*
    X * ngetch - get a (possibly pushed back) character
    X *
    X */
    Xchar
    Xngetch(c, fd)
    Xchar *c;
    XFILE *fd;
    X{
    X
    X    if (bp >= 0) {
    X        *c = buf[bp];
    X        bp--;
    X    }
    X    else
    X        *c = (char) getc(fd);
    X
    X    return(*c);
    X}
    X/*
    X * pbstr - push string back onto input
    X *
    X */
    Xpbstr(in)
    Xchar in[];
    X{
    X    int i;
    X
    X    for (i = strlen(in) - 1; i >= 0; i--)
    X        putbak(in[i]);
    X}
    X
    X/*
    X * putbak - push char back onto input
    X *
    X */
    Xputbak(c)
    Xchar c;
    X{
    X
    X    bp++;
    X    if (bp > BUFSIZE)
    X        baderr("too many characters pushed back.");
    X    buf[bp] = c;
    X}
    X
    X
    X/*
    X * relate - convert relational shorthands into long form
    X *
    X */
    Xint
    Xrelate(token, fd)
    Xchar token[];
    XFILE *fd;
    X{
    X
    X    if (ngetch(&token[1], fd) != EQUALS) {
    X        putbak(token[1]);
    X        token[2] = LETT;
    X    }
    X    else
    X        token[2] = LETE;
    X    token[3] = PERIOD;
    X    token[4] = EOS;
    X    token[5] = EOS;    /* for .not. and .and. */
    X    if (token[0] == GREATER)
    X        token[1] = LETG;
    X    else if (token[0] == LESS)
    X        token[1] = LETL;
    X    else if (token[0] == NOT || token[0] == BANG || token[0] == CARET) {
    X        if (token[1] != EQUALS) {
    X            token[2] = LETO;
    X            token[3] = LETT;
    X            token[4] = PERIOD;
    X        }
    X        token[1] = LETN;
    X    }
    X    else if (token[0] == EQUALS) {
    X        if (token[1] != EQUALS) {
    X            token[2] = EOS;
    X            return(0);
    X        }
    X        token[1] = LETE;
    X        token[2] = LETQ;
    X    }
    X    else if (token[0] == AND) {
    X        token[1] = LETA;
    X        token[2] = LETN;
    X        token[3] = LETD;
    X        token[4] = PERIOD;
    X    }
    X    else if (token[0] == OR) {
    X        token[1] = LETO;
    X        token[2] = LETR;
    X    }
    X    else   /* can't happen */
    X        token[1] = EOS;
    X    token[0] = PERIOD;
    X    return(strlen(token)-1);
    X}
    X
    X/*
    X * skpblk - skip blanks and tabs in file  fd
    X *
    X */
    Xskpblk(fd)
    XFILE *fd;
    X{
    X    char c;
    X
    X    for (c = ngetch(&c, fd); c == BLANK || c == TAB; c = ngetch(&c, fd))
    X        ;
    X    putbak(c);
    X}
    X
    X
    X/*
    X * type - return LETTER, DIGIT or char; works with ascii alphabet
    X *
    X */
    Xint
    Xtype(c)
    Xchar c;
    X{
    X    int t;
    X
    X    if (c >= DIG0 && c <= DIG9)
    X        t = DIGIT;
    X    else if (c >= LETA && c <= LETZ)
    X        t = LETTER;
    X    else if (c >= BIGA && c <= BIGZ)
    X        t = LETTER;
    X    else
    X        t = c;
    X    return(t);
    X}
    X
    X/*
    X * C O D E  G E N E R A T I O N
    X */
    X
    X/*
    X * brknxt - generate code for break n and next n; n = 1 is default
    X */
    Xbrknxt(sp, lextyp, labval, token)
    Xint sp;
    Xint lextyp[];
    Xint labval[];
    Xint token;
    X{
    X    int i, n;
    X    char t, ptoken[MAXTOK];
    X
    X    n = 0;
    X    t = gnbtok(ptoken, MAXTOK);
    X    if (alldig(ptoken) == YES) {     /* have break n or next n */
    X        i = 0;
    X        n = ctoi(ptoken, &i) - 1;
    X    }
    X    else if (t != SEMICOL)      /* default case */
    X        pbstr(ptoken);
    X    for (i = sp; i >= 0; i--)
    X        if (lextyp[i] == LEXWHILE || lextyp[i] == LEXDO
    X            || lextyp[i] == LEXFOR || lextyp[i] == LEXREPEAT) {
    X            if (n > 0) {
    X                n--;
    X                continue;             /* seek proper level */
    X            }
    X            else if (token == LEXBREAK)
    X                outgo(labval[i]+1);
    X            else
    X                outgo(labval[i]);
    X            xfer = YES;
    X            return;
    X        }
    X    if (token == LEXBREAK)
    X        synerr("illegal break.");
    X    else
    X        synerr("illegal next.");
    X    return;
    X}
    X
    X/*
    X * docode - generate code for beginning of do
    X *
    X */
    Xdocode(lab)
    Xint *lab;
    X{
    X    xfer = NO;
    X    outtab();
    X    outstr(sdo);
    X    *lab = labgen(2);
    X    outnum(*lab);
    X    eatup();
    X    outdon();
    X}
    X
    X/*
    X * dostat - generate code for end of do statement
    X *
    X */
    Xdostat(lab)
    Xint lab;
    X{
    X    outcon(lab);
    X    outcon(lab+1);
    X}
    X
    X/*
    X * elseif - generate code for end of if before else
    X *
    X */
    Xelseif(lab)
    Xint lab;
    X{
    X
    X#ifdef F77
    X    outtab();
    X    outstr(selse);
    X    outdon();
    X#else
    X    outgo(lab+1);
    X    outcon(lab);
    X#endif F77
    X}
    X
    X/*
    X * forcod - beginning of for statement
    X *
    X */
    Xforcod(lab)
    Xint *lab;
    X{
    X    char t, token[MAXTOK];
    X    int i, j, nlpar,tlab;
    X
    X    tlab = *lab;
    X    tlab = labgen(3);
    X    outcon(0);
    X    if (gnbtok(token, MAXTOK) != LPAREN) {
    X        synerr("missing left paren.");
    X        return;
    X    }
    X    if (gnbtok(token, MAXTOK) != SEMICOL) {   /* real init clause */
    X        pbstr(token);
    X        outtab();
    X        eatup();
    X        outdon();
    X    }
    X    if (gnbtok(token, MAXTOK) == SEMICOL)   /* empty condition */
    X        outcon(tlab);
    X    else {   /* non-empty condition */
    X        pbstr(token);
    X        outnum(tlab);
    X        outtab();
    X        outstr(ifnot);
    X        outch(LPAREN);
    X        nlpar = 0;
    X        while (nlpar >= 0) {
    X            t = gettok(token, MAXTOK);
    X            if (t == SEMICOL)
    X                break;
    X            if (t == LPAREN)
    X                nlpar++;
    X            else if (t == RPAREN)
    X                nlpar--;
    X            if (t == EOF) {
    X                pbstr(token);
    X                return;
    X            }
    X            if (t != NEWLINE && t != UNDERLINE)
    X                outstr(token);
    X        }
    X        outch(RPAREN);
    X        outch(RPAREN);
    X        outgo((tlab)+2);
    X        if (nlpar < 0)
    X            synerr("invalid for clause.");
    X    }
    X    fordep++;        /* stack reinit clause */
    X    j = 0;
    X    for (i = 1; i < fordep; i++)   /* find end *** should i = 1 ??? *** */
    X        j = j + strlen(&forstk[j]) + 1;
    X    forstk[j] = EOS;   /* null, in case no reinit */
    X    nlpar = 0;
    X    t = gnbtok(token, MAXTOK);
    X    pbstr(token);
    X    while (nlpar >= 0) {
    X        t = gettok(token, MAXTOK);
    X        if (t == LPAREN)
    X            nlpar++;
    X        else if (t == RPAREN)
    X            nlpar--;
    X        if (t == EOF) {
    X            pbstr(token);
    X            break;
    X        }
    X        if (nlpar >= 0 && t != NEWLINE && t != UNDERLINE) {
    X            if (j + strlen(token) >= MAXFORSTK)
    X                baderr("for clause too long.");
    X            scopy(token, 0, forstk, j);
    X            j = j + strlen(token);
    X        }
    X    }
    X    tlab++;   /* label for next's */
    X    *lab = tlab;
    X}
    X
    X/*
    X * fors - process end of for statement
    X *
    X */
    Xfors(lab)
    Xint lab;
    X{
    X    int i, j;
    X
    X    xfer = NO;
    X    outnum(lab);
    X    j = 0;
    X    for (i = 1; i < fordep; i++)
    X        j = j + strlen(&forstk[j]) + 1;
    X    if (strlen(&forstk[j]) > 0) {
    X        outtab();
    X        outstr(&forstk[j]);
    X        outdon();
    X    }
    X    outgo(lab-1);
    X    outcon(lab+1);
    X    fordep--;
    X}
    X
    X/*
    X * ifcode - generate initial code for if
    X *
    X */
    Xifcode(lab)
    Xint *lab;
    X{
    X
    X    xfer = NO;
    X    *lab = labgen(2);
    X#ifdef F77
    X    ifthen();
    X#else
    X    ifgo(*lab);
    X#endif F77
    X}
    X
    X#ifdef F77
    X/*
    X * ifend - generate code for end of if
    X *
    X */
    Xifend()
    X{
    X    outtab();
    X    outstr(sendif);
    X    outdon();
    X}
    X#endif F77
    X
    X/*
    X * ifgo - generate "if(.not.(...))goto lab"
    X *
    X */
    Xifgo(lab)
    Xint lab;
    X{
    X
    X    outtab();      /* get to column 7 */
    X    outstr(ifnot);      /* " if(.not. " */
    X    balpar();      /* collect and output condition */
    X    outch(RPAREN);      /* " ) " */
    X    outgo(lab);         /* " goto lab " */
    X}
    X
    X#ifdef F77
    X/*
    X * ifthen - generate "if((...))then"
    X *
    X */
    Xifthen()
    X{
    X    outtab();
    X    outstr(sif);
    X    balpar();
    X    outstr(sthen);
    X    outdon();
    X}
    X#endif F77
    X
    X/*
    X * labelc - output statement number
    X *
    X */
    Xlabelc(lexstr)
    Xchar lexstr[];
    X{
    X
    X    xfer = NO;   /* can't suppress goto's now */
    X    if (strlen(lexstr) == 5)   /* warn about 23xxx labels */
    X        if (atoi(lexstr) >= startlab)
    X            synerr("warning: possible label conflict.");
    X    outstr(lexstr);
    X    outtab();
    X}
    X
    X/*
    X * labgen - generate  n  consecutive labels, return first one
    X *
    X */
    Xint
    Xlabgen(n)
    Xint n;
    X{
    X    int i;
    X
    X    i = label;
    X    label = label + n;
    X    return(i);
    X}
    X
    X/*
    X * otherc - output ordinary Fortran statement
    X *
    X */
    Xotherc(lexstr)
    Xchar lexstr[];
    X{
    X    xfer = NO;
    X    outtab();
    X    outstr(lexstr);
    X    eatup();
    X    outdon();
    X}
    X
    X/*
    X * outch - put one char into output buffer
    X *
    X */
    Xoutch(c)
    Xchar c;
    X{
    X    int i;
    X
    X    if (outp >= 72) {   /* continuation card */
    X        outdon();
    X        for (i = 0; i < 6; i++)
    X            outbuf[i] = BLANK;
    X        outp = 6;
    X    }
    X    outbuf[outp] = c;
    X    outp++;
    X}
    X
    X/*
    X * outcon - output "n   continue"
    X *
    X */
    Xoutcon(n)
    Xint n;
    X{
    X    xfer = NO;
    X    if (n <= 0 && outp == 0)
    X        return;            /* don't need unlabeled continues */
    X    if (n > 0)
    X        outnum(n);
    X    outtab();
    X    outstr(contin);
    X    outdon();
    X}
    X
    X/*
    X * outdon - finish off an output line
    X *
    X */
    Xoutdon()
    X{
    X
    X    outbuf[outp] = NEWLINE;
    X    outbuf[outp+1] = EOS;
    X    printf("%s", outbuf);
    X    outp = 0;
    X}
    X
    X/*
    X * outgo - output "goto  n"
    X *
    X */
    Xoutgo(n)
    Xint n;
    X{
    X    if (xfer == YES)
    X        return;
    X    outtab();
    X    outstr(rgoto);
    X    outnum(n);
    X    outdon();
    X}
    X
    X/*
    X * outnum - output decimal number
    X *
    X */
    Xoutnum(n)
    Xint n;
    X{
    X
    X    char chars[MAXCHARS];
    X    int i, m;
    X
    X    m = abs(n);
    X    i = -1;
    X    do {
    X        i++;
    X        chars[i] = (m % 10) + DIG0;
    X        m = m / 10;
    X    }
    X    while (m > 0 && i < MAXCHARS);
    X    if (n < 0)
    X        outch(MINUS);
    X    for ( ; i >= 0; i--)
    X        outch(chars[i]);
    X}
    X
    X
    X
    X/*
    X * outstr - output string
    X *
    X */
    Xoutstr(str)
    Xchar str[];
    X{
    X    int i;
    X
    X    for (i=0; str[i] != EOS; i++)
    X        outch(str[i]);
    X}
    X
    X/*
    X * outtab - get past column 6
    X *
    X */
    Xouttab()
    X{
    X    while (outp < 6)
    X        outch(BLANK);
    X}
    X
    X
    X/*
    X * repcod - generate code for beginning of repeat
    X *
    X */
    Xrepcod(lab)
    Xint *lab;
    X{
    X
    X    int tlab;
    X
    X    tlab = *lab;
    X    outcon(0);   /* in case there was a label */
    X    tlab = labgen(3);
    X    outcon(tlab);
    X    *lab = ++tlab;        /* label to go on next's */
    X}
    X
    X/*
    X * retcod - generate code for return
    X *
    X */
    Xretcod()
    X{
    X    char token[MAXTOK], t;
    X
    X    t = gnbtok(token, MAXTOK);
    X    if (t != NEWLINE && t != SEMICOL && t != RBRACE) {
    X        pbstr(token);
    X        outtab();
    X        outstr(fcname);
    X        outch(EQUALS);
    X        eatup();
    X        outdon();
    X    }
    X    else if (t == RBRACE)
    X        pbstr(token);
    X    outtab();
    X    outstr(sret);
    X    outdon();
    X    xfer = YES;
    X}
    X
    X
    X/* strdcl - generate code for string declaration */
    Xstrdcl()
    X{
    X    char t, name[MAXNAME], init[MAXTOK];
    X    int i, len;
    X
    X    t = gnbtok(name, MAXNAME);
    X    if (t != ALPHA)
    X        synerr("missing string name.");
    X    if (gnbtok(init, MAXTOK) != LPAREN) {  /* make size same as initial value */
    X        len = strlen(init) + 1;
    X        if (init[1] == SQUOTE || init[1] == DQUOTE)
    X            len = len - 2;
    X    }
    X    else {    /* form is string name(size) init */
    X        t = gnbtok(init, MAXTOK);
    X        i = 0;
    X        len = ctoi(init, &i);
    X        if (init[i] != EOS)
    X            synerr("invalid string size.");
    X        if (gnbtok(init, MAXTOK) != RPAREN)
    X            synerr("missing right paren.");
    X        else
    X            t = gnbtok(init, MAXTOK);
    X    }
    X    outtab();
    X    /*
    X    *   outstr(int);
    X    */
    X    outstr(name);
    X    outch(LPAREN);
    X    outnum(len);
    X    outch(RPAREN);
    X    outdon();
    X    outtab();
    X    outstr(dat);
    X    len = strlen(init) + 1;
    X    if (init[0] == SQUOTE || init[0] == DQUOTE) {
    X        init[len-1] = EOS;
    X        scopy(init, 1, init, 0);
    X        len = len - 2;
    X    }
    X    for (i = 1; i <= len; i++) {    /* put out variable names */
    X        outstr(name);
    X        outch(LPAREN);
    X        outnum(i);
    X        outch(RPAREN);
    X        if (i < len)
    X            outch(COMMA);
    X        else
    X            outch(SLASH);
    X        ;
    X    }
    X    for (i = 0; init[i] != EOS; i++) {    /* put out init */
    X        outnum(init[i]);
    X        outch(COMMA);
    X    }
    X    pbstr(eoss);    /* push back EOS for subsequent substitution */
    X}
    X
    X
    X/*
    X * unstak - unstack at end of statement
    X *
    X */
    Xunstak(sp, lextyp, labval, token)
    Xint *sp;
    Xint lextyp[];
    Xint labval[];
    Xchar token;
    X{
    X    int tp;
    X
    X    tp = *sp;
    X    for ( ; tp > 0; tp--) {
    X        if (lextyp[tp] == LBRACE)
    X            break;
    X        if (lextyp[tp] == LEXSWITCH)
    X            break;
    X        if (lextyp[tp] == LEXIF && token == LEXELSE)
    X            break;
    X        if (lextyp[tp] == LEXIF)
    X#ifdef F77
    X            ifend();
    X#else
    X            outcon(labval[tp]);
    X#endif F77
    X        else if (lextyp[tp] == LEXELSE) {
    X            if (*sp > 1)
    X                tp--;
    X#ifdef F77
    X            ifend();
    X#else
    X            outcon(labval[tp]+1);
    X#endif F77
    X        }
    X        else if (lextyp[tp] == LEXDO)
    X            dostat(labval[tp]);
    X        else if (lextyp[tp] == LEXWHILE)
    X            whiles(labval[tp]);
    X        else if (lextyp[tp] == LEXFOR)
    X            fors(labval[tp]);
    X        else if (lextyp[tp] == LEXREPEAT)
    X            untils(labval[tp], token);
    X    }
    X    *sp = tp;
    X}
    X
    X/*
    X * untils - generate code for until or end of repeat
    X *
    X */
    Xuntils(lab, token)
    Xint lab;
    Xint token;
    X{
    X    char ptoken[MAXTOK];
    X
    X    xfer = NO;
    X    outnum(lab);
    X    if (token == LEXUNTIL) {
    X        lex(ptoken);
    X        ifgo(lab-1);
    X    }
    X    else
    X        outgo(lab-1);
    X    outcon(lab+1);
    X}
    X
    X/*
    X * whilec - generate code for beginning of while
    X *
    X */
    Xwhilec(lab)
    Xint *lab;
    X{
    X    int tlab;
    X
    X    tlab = *lab;
    X    outcon(0);         /* unlabeled continue, in case there was a label */
    X    tlab = labgen(2);
    X    outnum(tlab);
    X#ifdef F77
    X    ifthen();
    X#else
    X    ifgo(tlab+1);
    X#endif F77
    X    *lab = tlab;
    X}
    X
    X/*
    X * whiles - generate code for end of while
    X *
    X */
    Xwhiles(lab)
    Xint lab;
    X{
    X
    X    outgo(lab);
    X#ifdef F77
    X    ifend();
    X#endif F77
    X    outcon(lab+1);
    X}
    X
    X/*
    X * E R R O R  M E S S A G E S
    X */
    X
    X/*
    X *  baderr - print error message, then die
    X */
    Xbaderr(msg)
    Xchar msg[];
    X{
    X    synerr(msg);
    X    exit(1);
    X}
    X
    X/*
    X * error - print error message with one parameter, then die
    X */
    Xerror(msg, s)
    Xchar *msg, *s;
    X{
    X    fprintf(stderr, msg,s);
    X    exit(1);
    X}
    X
    X/*
    X * synerr - report Ratfor syntax error
    X */
    Xsynerr(msg)
    Xchar *msg;
    X{
    X    char lc[MAXCHARS];
    X    int i;
    X
    X    fprintf(stderr,errmsg);
    X    if (level >= 0)
    X        i = level;
    X    else
    X        i = 0;   /* for EOF errors */
    X    itoc(linect[i], lc, MAXCHARS);
    X    fprintf(stderr,lc);
    X    for (i = fnamp - 1; i > 1; i = i - 1)
    X        if (fnames[i-1] == EOS) {   /* print file name */
    X            fprintf(stderr,in);
    X            fprintf(stderr,&fnames[i]);
    X            break;
    X        }
    X    fprintf(stderr,": \n      %s\n",msg);
    X}
    X
    X
    X/*
    X * U T I L I T Y  R O U T I N E S
    X */
    X
    X/*
    X * ctoi - convert string at in[i] to int, increment i
    X */
    Xint
    Xctoi(in, i)
    Xchar in[];
    Xint *i;
    X{
    X    int k, j;
    X
    X    j = *i;
    X    while (in[j] == BLANK || in[j] == TAB)
    X        j++;
    X    for (k = 0; in[j] != EOS; j++) {
    X        if (in[j] < DIG0 || in[j] > DIG9)
    X            break;
    X        k = 10 * k + in[j] - DIG0;
    X    }
    X    *i = j;
    X    return(k);
    X}
    X
    X/*
    X * fold - convert alphabetic token to single case
    X *
    X */
    Xfold(token)
    Xchar token[];
    X{
    X
    X    int i;
    X
    X    /* WARNING - this routine depends heavily on the */
    X    /* fact that letters have been mapped into internal */
    X    /* right-adjusted ascii. god help you if you */
    X    /* have subverted this mechanism. */
    X
    X    for (i = 0; token[i] != EOS; i++)
    X        if (token[i] >= BIGA && token[i] <= BIGZ)
    X            token[i] = token[i] - BIGA + LETA;
    X}
    X
    X/*
    X * equal - compare str1 to str2; return YES if equal, NO if not
    X *
    X */
    Xint
    Xequal(str1, str2)
    Xchar str1[];
    Xchar str2[];
    X{
    X    int i;
    X
    X    for (i = 0; str1[i] == str2[i]; i++)
    X        if (str1[i] == EOS)
    X            return(YES);
    X    return(NO);
    X}
    X
    X/*
    X * scopy - copy string at from[i] to to[j]
    X *
    X */
    Xscopy(from, i, to, j)
    Xchar from[];
    Xint i;
    Xchar to[];
    Xint j;
    X{
    X    int k1, k2;
    X
    X    k2 = j;
    X    for (k1 = i; from[k1] != EOS; k1++) {
    X        to[k2] = from[k1];
    X        k2++;
    X    }
    X    to[k2] = EOS;
    X}
    X
    X#include "lookup.h"
    X/*
    X * look - look-up a definition
    X *
    X */
    Xint
    Xlook(name,defn)
    Xchar name[];
    Xchar defn[];
    X{
    X    extern struct hashlist *lookup();
    X    struct hashlist *p;
    X
    X    if ((p = lookup(name)) == NULL)
    X        return(NO);
    X    (void) strcpy(defn,p->def);
    X    return(YES);
    X}
    X
    X/*
    X * itoc - special version of itoa
    X */
    Xint
    Xitoc(n,str,size)
    Xint n;
    Xchar str[];
    Xint size;
    X{
    X    int i,j,k,sign;
    X    char c;
    X
    X    if ((sign = n) < 0)
    X        n = -n;
    X    i = 0;
    X    do {
    X        str[i++] = n % 10 + '0';
    X    }
    X    while ((n /= 10) > 0 && i < size-2);
    X    if (sign < 0 && i < size-1)
    X        str[i++] = '-';
    X    str[i] = EOS;
    X    /*
    X     * reverse the string and plug it back in
    X     */
    X    for (j = 0, k = strlen(str) - 1; j < k; j++, k--) {
    X        c = str[j];
    X        str[j] = str[k];
    X        str[k] = c;
    X    }
    X    return(i-1);
    X}
    X
    X/*
    X * cascod - generate code for case or default label
    X *
    X */
    Xcascod (lab, token)
    Xint lab;
    Xint token;
    X{
    X    int t, l, lb, ub, i, j, junk;
    X    char scrtok[MAXTOK];
    X
    X    if (swtop <= 0) {
    X        synerr ("illegal case or default.");
    X        return;
    X    }
    X    outgo(lab + 1);        /* # terminate previous case */
    X    xfer = YES;
    X    l = labgen(1);
    X    if (token == LEXCASE) {     /* # case n[,n]... : ... */
    X        while (caslab (&lb, &t) != EOF) {
    X            ub = lb;
    X            if (t == MINUS)
    X                junk = caslab (&ub, &t);
    X            if (lb > ub) {
    X                synerr ("illegal range in case label.");
    X                ub = lb;
    X            }
    X            if (swlast + 3 > MAXSWITCH)
    X                baderr ("switch table overflow.");
    X            for (i = swtop + 3; i < swlast; i = i + 3)
    X                if (lb <= swstak[i])
    X                    break;
    X                else if (lb <= swstak[i+1])
    X                    synerr ("duplicate case label.");
    X            if (i < swlast && ub >= swstak[i])
    X                synerr ("duplicate case label.");
    X            for (j = swlast; j > i; j--)       /* # insert new entry */
    X                swstak[j+2] = swstak[j-1];
    X            swstak[i] = lb;
    X            swstak[i + 1] = ub;
    X            swstak[i + 2] = l;
    X            swstak[swtop + 1] = swstak[swtop + 1]  +  1;
    X            swlast = swlast + 3;
    X            if (t == COLON)
    X                break;
    X            else if (t != COMMA)
    X                synerr ("illegal case syntax.");
    X        }
    X    }
    X    else {                       /* # default : ... */
    X        t = gnbtok (scrtok, MAXTOK);
    X        if (swstak[swtop + 2] != 0)
    X            baderr ("multiple defaults in switch statement.");
    X        else
    X            swstak[swtop + 2] = l;
    X    }
    X
    X    if (t == EOF)
    X        synerr ("unexpected EOF.");
    X    else if (t != COLON)
    X        baderr ("missing colon in case or default label.");
    X
    X    xfer = NO;
    X    outcon (l);
    X}
    X
    X/*
    X * caslab - get one case label
    X *
    X */
    Xint
    Xcaslab (n, t)
    Xint *n;
    Xint *t;
    X{
    X    char tok[MAXTOK];
    X    int i, s;
    X
    X    *t = gnbtok (tok, MAXTOK);
    X    while (*t == NEWLINE)
    X        *t = gnbtok (tok, MAXTOK);
    X    if (*t == EOF)
    X        return (*t);
    X    if (*t == MINUS)
    X        s = -1;
    X    else
    X        s = 1;
    X    if (*t == MINUS || *t == PLUS)
    X        *t = gnbtok (tok, MAXTOK);
    X    if (*t != DIGIT) {
    X        synerr ("invalid case label.");
    X        *n = 0;
    X    }
    X    else {
    X        i = 0;
    X        *n = s * ctoi (tok, &i);
    X    }
    X    *t = gnbtok (tok, MAXTOK);
    X    while (*t == NEWLINE)
    X        *t = gnbtok (tok, MAXTOK);
    X}
    X
    X/*
    X * swcode - generate code for switch stmt.
    X *
    X */
    Xswcode (lab)
    Xint *lab;
    X{
    X    char scrtok[MAXTOK];
    X
    X    *lab = labgen (2);
    X    if (swlast + 3 > MAXSWITCH)
    X        baderr ("switch table overflow.");
    X    swstak[swlast] = swtop;
    X    swstak[swlast + 1] = 0;
    X    swstak[swlast + 2] = 0;
    X    swtop = swlast;
    X    swlast = swlast + 3;
    X    xfer = NO;
    X    outtab();      /* # Innn=(e) */
    X    swvar(*lab);
    X    outch(EQUALS);
    X    balpar();
    X    outdon();
    X    outgo(*lab);     /* # goto L */
    X    xfer = YES;
    X    while (gnbtok (scrtok, MAXTOK) == NEWLINE)
    X        ;
    X    if (scrtok[0] != LBRACE) {
    X        synerr ("missing left brace in switch statement.");
    X        pbstr (scrtok);
    X    }
    X}
    X
    X/*
    X * swend  - finish off switch statement; generate dispatch code
    X *
    X */
    Xswend(lab)
    Xint lab;
    X{
    X    int lb, ub, n, i, j;
    X
    Xstatic    char *sif       = "if (";
    Xstatic    char *slt       = ".lt.1.or.";
    Xstatic    char *sgt       = ".gt.";
    Xstatic    char *sgoto     = "goto (";
    Xstatic    char *seq       = ".eq.";
    Xstatic    char *sge       = ".ge.";
    Xstatic    char *sle       = ".le.";
    Xstatic    char *sand      = ".and.";
    X
    X    lb = swstak[swtop + 3];
    X    ub = swstak[swlast - 2];
    X    n = swstak[swtop + 1];
    X    outgo(lab + 1);             /* # terminate last case */
    X    if (swstak[swtop + 2] == 0)
    X        swstak[swtop + 2] = lab + 1;    /* # default default label */
    X    xfer = NO;
    X    outcon (lab);              /*  L   continue */
    X    /* output branch table */
    X    if (n >= CUTOFF && ub - lb < DENSITY * n) {
    X        if (lb != 0) {            /* L  Innn=Innn-lb */
    X            outtab();
    X            swvar  (lab);
    X            outch (EQUALS);
    X            swvar  (lab);
    X            if (lb < 0)
    X                outch (PLUS);
    X            outnum (-lb + 1);
    X            outdon();
    X        }
    X        outtab();  /*  if (Innn.lt.1.or.Innn.gt.ub-lb+1)goto default */
    X        outstr (sif);
    X        swvar  (lab);
    X        outstr (slt);
    X        swvar  (lab);
    X        outstr (sgt);
    X        outnum (ub - lb + 1);
    X        outch (RPAREN);
    X        outgo (swstak[swtop + 2]);
    X        outtab();
    X        outstr (sgoto);        /* goto ... */
    X        j = lb;
    X        for (i = swtop + 3; i < swlast; i = i + 3) {
    X            /* # fill in vacancies */
    X            for ( ; j < swstak[i]; j++) {
    X                outnum(swstak[swtop + 2]);
    X                outch(COMMA);
    X            }
    X            for (j = swstak[i + 1] - swstak[i]; j >= 0; j--)
    X                outnum(swstak[i + 2]);    /* # fill in range */
    X            j = swstak[i + 1] + 1;
    X            if (i < swlast - 3)
    X                outch(COMMA);
    X        }
    X        outch(RPAREN);
    X        outch(COMMA);
    X        swvar(lab);
    X        outdon();
    X    }
    X    else if (n > 0) {         /* # output linear search form */
    X        for (i = swtop + 3; i < swlast; i = i + 3) {
    X            outtab();        /* # if (Innn */
    X            outstr (sif);
    X            swvar  (lab);
    X            if (swstak[i] == swstak[i+1]) {
    X                outstr (seq);     /* #   .eq....*/
    X                outnum (swstak[i]);
    X            }
    X            else {
    X                outstr (sge);    /* #   .ge.lb.and.Innn.le.ub */
    X                outnum (swstak[i]);
    X                outstr (sand);
    X                swvar  (lab);
    X                outstr (sle);
    X                outnum (swstak[i + 1]);
    X            }
    X            outch (RPAREN);        /* #    ) goto ... */
    X            outgo (swstak[i + 2]);
    X        }
    X        if (lab + 1 != swstak[swtop + 2])
    X            outgo (swstak[swtop + 2]);
    X    }
    X    outcon (lab + 1);               /* # L+1  continue */
    X    swlast = swtop;                /* # pop switch stack */
    X    swtop = swstak[swtop];
    X}
    X
    X/*
    X * swvar  - output switch variable Innn, where nnn = lab
    X */
    Xswvar  (lab)
    Xint lab;
    X{
    X
    X    outch ('I');
    X    outnum (lab);
    X}
SHAR_EOF
if test 33966 -ne "`wc -c < 'rat4.c'`"
then
    echo shar: error transmitting "'rat4.c'" '(should have been 33966 characters)'
fi
chmod +x 'rat4.c'
fi # end of overwriting check
echo shar: extracting "'lookup.c'" '(1397 characters)'
if test -f 'lookup.c'
then
    echo shar: will not over-write existing file "'lookup.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'lookup.c'
    X#include <stdio.h>
    X#include "lookup.h"
    X
    Xstatic
    Xstruct    hashlist *hashtab[HASHMAX];
    X
    X/*
    X * from K&R "The C Programming language"
    X * Table lookup routines
    X *
    X * hash - for a hash value for string s
    X *
    X */
    Xhash(s)
    Xchar *s;
    X{
    X    int    hashval;
    X
    X    for (hashval = 0; *s != '\0';)
    X        hashval += *s++;
    X    return (hashval % HASHMAX);
    X}
    X
    X/*
    X * lookup - lookup for a string s in the hash table
    X *
    X */
    Xstruct hashlist
    X*lookup(s)
    Xchar *s;
    X{
    X    struct hashlist *np;
    X
    X    for (np = hashtab[hash(s)]; np != NULL; np = np->next)
    X        if (strcmp(s, np->name) == 0)
    X            return(np);    /* found     */
    X    return(NULL);        /* not found */
    X}
    X
    X/*
    X * install - install a string name in hashtable and its value def
    X *
    X */
    Xstruct hashlist
    X*install(name,def)
    Xchar *name;
    Xchar *def;
    X{
    X    int hashval;
    X    struct hashlist *np, *lookup();
    X    char *strsave(), *malloc();
    X
    X    if ((np = lookup(name)) == NULL) {    /* not found.. */
    X        np = (struct hashlist *) malloc(sizeof(*np));
    X        if (np == NULL)
    X            return(NULL);
    X        if ((np->name = strsave(name)) == NULL)
    X            return(NULL);
    X        hashval = hash(np->name);
    X        np->next = hashtab[hashval];
    X        hashtab[hashval] = np;
    X    } else                    /* found..     */
    X        free(np->def);            /* free prev.  */
    X    if ((np->def = strsave(def)) == NULL)
    X        return(NULL);
    X    return(np);
    X}
    X
    X/*
    X * strsave - save string s somewhere
    X *
    X */
    Xchar
    X*strsave(s)
    Xchar *s;
    X{
    X    char *p, *malloc();
    X
    X    if ((p = malloc(strlen(s)+1)) != NULL)
    X        strcpy(p, s);
    X    return(p);
    X}
    X
    X
SHAR_EOF
if test 1397 -ne "`wc -c < 'lookup.c'`"
then
    echo shar: error transmitting "'lookup.c'" '(should have been 1397 characters)'
fi
chmod +x 'lookup.c'
fi # end of overwriting check
echo shar: extracting "'getopt.c'" '(969 characters)'
if test -f 'getopt.c'
then
    echo shar: will not over-write existing file "'getopt.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'getopt.c'
    X/*
    X * getopt - get option letter from argv
    X */
    X
    X#include <stdio.h>
    X
    Xchar    *optarg;    /* Global argument pointer. */
    Xint    optind = 0;    /* Global argv index. */
    X
    Xstatic char    *scan = NULL;    /* Private scan pointer. */
    X
    Xextern char    *index();
    X
    Xint
    Xgetopt(argc, argv, optstring)
    Xint argc;
    Xchar *argv[];
    Xchar *optstring;
    X{
    X    register char c;
    X    register char *place;
    X
    X    optarg = NULL;
    X
    X    if (scan == NULL || *scan == '\0') {
    X        if (optind == 0)
    X            optind++;
    X
    X        if (optind >= argc || argv[optind][0] != '-' || argv[optind][1] == '\0')
    X            return(EOF);
    X        if (strcmp(argv[optind], "--")==0) {
    X            optind++;
    X            return(EOF);
    X        }
    X
    X        scan = argv[optind]+1;
    X        optind++;
    X    }
    X
    X    c = *scan++;
    X    place = index(optstring, c);
    X
    X    if (place == NULL || c == ':') {
    X        fprintf(stderr, "%s: unknown option -%c\n", argv[0], c);
    X        return('?');
    X    }
    X
    X    place++;
    X    if (*place == ':') {
    X        if (*scan != '\0') {
    X            optarg = scan;
    X            scan = NULL;
    X        } else {
    X            optarg = argv[optind];
    X            optind++;
    X        }
    X    }
    X
    X    return(c);
    X}
    X
SHAR_EOF
if test 969 -ne "`wc -c < 'getopt.c'`"
then
    echo shar: error transmitting "'getopt.c'" '(should have been 969 characters)'
fi
chmod +x 'getopt.c'
fi # end of overwriting check
echo shar: extracting "'ratdef.h'" '(3579 characters)'
if test -f 'ratdef.h'
then
    echo shar: will not over-write existing file "'ratdef.h'"
else
sed 's/^    X//' << \SHAR_EOF > 'ratdef.h'
    X#define ACCENT  96
    X#define AND     38
    X#define APPEND
    X#define ATSIGN  64
    X#define BACKSLASH       92
    X#define BACKSPACE       8
    X#define BANG    33
    X#define BAR     124
    X#define BIGA    65
    X#define BIGB    66
    X#define BIGC    67
    X#define BIGD    68
    X#define BIGE    69
    X#define BIGF    70
    X#define BIGG    71
    X#define BIGH    72
    X#define BIGI    73
    X#define BIGJ    74
    X#define BIGK    75
    X#define BIGL    76
    X#define BIGM    77
    X#define BIGN    78
    X#define BIGO    79
    X#define BIGP    80
    X#define BIGQ    81
    X#define BIGR    82
    X#define BIGS    83
    X#define BIGT    84
    X#define BIGU    85
    X#define BIGV    86
    X#define BIGW    87
    X#define BIGX    88
    X#define BIGY    89
    X#define BIGZ    90
    X#define BLANK   32
    X#define CARET   94
    X#define COLON   58
    X#define COMMA   44
    X#define CRLF    13
    X#define DIG0    48
    X#define DIG1    49
    X#define DIG2    50
    X#define DIG3    51
    X#define DIG4    52
    X#define DIG5    53
    X#define DIG6    54
    X#define DIG7    55
    X#define DIG8    56
    X#define DIG9    57
    X#define DOLLAR  36
    X#define DQUOTE  34
    X#define EOS     0
    X#define EQUALS  61
    X#define ESCAPE  ATSIGN
    X#define GREATER 62
    X#define HUGE    30000
    X#define LBRACE  123
    X#define LBRACK  91
    X#define LESS    60
    X#define LETA    97
    X#define LETB    98
    X#define LETC    99
    X#define LETD    100
    X#define LETE    101
    X#define LETF    102
    X#define LETG    103
    X#define LETH    104
    X#define LETI    105
    X#define LETJ    106
    X#define LETK    107
    X#define LETL    108
    X#define LETM    109
    X#define LETN    110
    X#define LETO    111
    X#define LETP    112
    X#define LETQ    113
    X#define LETR    114
    X#define LETS    115
    X#define LETT    116
    X#define LETU    117
    X#define LETV    118
    X#define LETW    119
    X#define LETX    120
    X#define LETY    121
    X#define LETZ    122
    X#define LPAREN  40
    X#define MINUS   45
    X#define NEWLINE 10
    X#define NO      0
    X#define NOT     126
    X#define OR      BAR    /* same as | */
    X#define PERCENT 37
    X#define PERIOD  46
    X#define PLUS    43
    X#define QMARK   63
    X#define RBRACE  125
    X#define RBRACK  93
    X#define RPAREN  41
    X#define SEMICOL 59
    X#define SHARP   35
    X#define SLASH   47
    X#define SQUOTE  39
    X#define STAR    42
    X#define TAB     9
    X#define TILDE   126
    X#define UNDERLINE       95
    X#define YES     1
    X
    X#define LIMIT   134217728
    X#define LIM1    28
    X#define LIM2    -28
    X
    X/*
    X * lexical analyser symbols
    X *
    X */
    X
    X#define LETTER        1
    X#define DIGIT       2
    X#define ALPHA       3
    X#define LEXBREAK       4
    X#define LEXDIGITS       5
    X#define LEXDO       6
    X#define LEXELSE       7
    X#define LEXFOR       8
    X#define LEXIF       9
    X#define LEXNEXT       10
    X#define LEXOTHER       11
    X#define LEXREPEAT       12
    X#define LEXUNTIL       13
    X#define LEXWHILE       14
    X#define LEXRETURN       15
    X#define LEXEND       16
    X#define LEXSTOP       17
    X#define LEXSTRING       18
    X#define LEXSWITCH    19
    X#define LEXCASE        20
    X#define LEXDEFAULT    21
    X#define DEFTYPE       22
    X
    X#define MAXCHARS       10       /* characters for outnum */
    X#define MAXDEF       200       /* max chars in a defn */
    X#define MAXSWITCH       300     /* max stack for switch statement */
    X#define CUTOFF          3       /* min number of cases necessary to generate */
    X                                /* a dispatch table */
    X#define DENSITY         2
    X#define MAXFORSTK       200       /* max space for for reinit clauses */
    X#define MAXFNAMES       350      /* max chars in filename stack NFILES*MAXNAME */
    X#define MAXNAME       64       /* file name size in gettok */
    X#define MAXSTACK       100       /* max stack depth for parser */
    X#define MAXTBL       15000   /* max chars in all definitions */
    X#define MAXTOK       132       /* max chars in a token */
    X#define NFILES       7       /* max depth of file inclusion */
    X
    X#define RADIX       PERCENT /* % indicates alternate radix */
    X#define BUFSIZE       300       /* pushback buffer for ngetch and putbak */
    X
SHAR_EOF
if test 3579 -ne "`wc -c < 'ratdef.h'`"
then
    echo shar: error transmitting "'ratdef.h'" '(should have been 3579 characters)'
fi
chmod +x 'ratdef.h'
fi # end of overwriting check
echo shar: extracting "'ratcom.h'" '(1206 characters)'
if test -f 'ratcom.h'
then
    echo shar: will not over-write existing file "'ratcom.h'"
else
sed 's/^    X//' << \SHAR_EOF > 'ratcom.h'
    Xint bp;            /*   next available char; init = 0 */
    Xchar buf[BUFSIZE];    /*   pushed-back chars */
    Xchar fcname[MAXNAME];    /*   text of current function name */
    Xint fordep;        /*   current depth of for statements */
    Xchar forstk[MAXFORSTK];    /*   stack of reinit strings */
    Xint swtop;        /*   current switch entry; init=0              */
    Xint swlast;        /*   next available position; init=1           */
    Xint swstak[MAXSWITCH];    /*   switch information stack                  */
    Xint xfer;        /*   YES if just made transfer, NO otherwise */
    Xint label;        /*   next label returned by labgen */
    Xint level ;        /*   level of file inclusion; init = 1 */
    Xint linect[NFILES];    /*   line count on input file[level]; init = 1 */
    XFILE *infile[NFILES];    /*   file number[level]; init infile[1] = STDIN */
    Xint fnamp;        /*   next free slot in fnames; init = 2 */
    Xchar fnames[MAXFNAMES];    /*   stack of include names; init fnames[1] = EOS */
    Xint avail;        /*   first first location in table; init = 1 */
    Xint tabptr[127];    /*   name pointers; init = 0 */
    Xint outp;        /*   last position filled in outbuf; init = 0 */
    Xchar outbuf[74];    /*   output lines collected here */
    Xchar fname[MAXNAME][NFILES];    /*   file names */
    Xint nfiles;        /*   number of files */
SHAR_EOF
if test 1206 -ne "`wc -c < 'ratcom.h'`"
then
    echo shar: error transmitting "'ratcom.h'" '(should have been 1206 characters)'
fi
chmod +x 'ratcom.h'
fi # end of overwriting check
echo shar: extracting "'lookup.h'" '(309 characters)'
if test -f 'lookup.h'
then
    echo shar: will not over-write existing file "'lookup.h'"
else
sed 's/^    X//' << \SHAR_EOF > 'lookup.h'
    X
    X/*
    X * from K&R "The C Programming language"
    X * Table lookup routines
    X * structure and definitions
    X *
    X */
    X
    X                    /* basic table entry */
    Xstruct hashlist {
    X    char    *name;
    X    char    *def;
    X    struct    hashlist *next;        /* next in chain     */
    X};
    X
    X#define HASHMAX    100            /* size of hashtable */
    X
    X                    /* hash table itself */
SHAR_EOF
if test 309 -ne "`wc -c < 'lookup.h'`"
then
    echo shar: error transmitting "'lookup.h'" '(should have been 309 characters)'
fi
chmod +x 'lookup.h'
fi # end of overwriting check
echo shar: extracting "'README'" '(739 characters)'
if test -f 'README'
then
    echo shar: will not over-write existing file "'README'"
else
sed 's/^    X//' << \SHAR_EOF > 'README'
    X    This is a C version of ratfor, derived from a UofA ratfor
    X    in ratfor. It was originally released to the net sometime
    X    ago, and It is re-released for the benefit of those sites
    X    who only get mod->comp.sources.
    X
    X    It now includes minor changes to produce F77 code as well.
    X
    X    This code *is* PD. You (public) have all the rights to the code.
    X    [But this also means you (singular) do not have any *extra*
    X    rights to the code, hence it is impossible for you to restrict
    X    the use and distribution of this code in any way.]
    X
    X    I would, as usual, appreciate hearing about bug fixes and
    X    improvements.
    X
    X    oz
    X
    X    Usenet: [decvax|ihnp4]!utzoo!yunexus!oz ||
    X            ...seismo!mnetor!yunexus!oz
    X    Bitnet: oz@[yusol|yuyetti].BITNET
    X    Phonet: [416] 736-5257 x 3976
SHAR_EOF
chmod +x 'README'
fi # end of overwriting check
echo shar: extracting "'ratfor.doc'" '(2471 characters)'
if test -f 'ratfor.doc'
then
    echo shar: will not over-write existing file "'ratfor.doc'"
else
sed 's/^    X//' << \SHAR_EOF > 'ratfor.doc'
    Xratfor - ratfor preprocessor
    X
    Xsynopsis:
    X        ratfor [-l n] [-o output] input
    X
    XRatfor has the following syntax:
    X
    Xprog:   stat
    X        prog stat
    X
    Xstat:   if (...) stat
    X        if (...) stat else stat
    X        while (...) stat
    X        repeat stat
    X        repeat stat until (...)
    X        for (...;...;...) stat
    X        do ... stat
    X        switch (intexpr) { case val[,val]: stmt ... default: stmt }
    X        break n
    X        next n
    X        return (...)
    X        digits stat
    X        { prog }  or  [ prog ]  or  $( prog $)
    X        anything unrecognizable
    X
    Xwhere stat is any Fortran or Ratfor statement, and intexpr is an
    Xexpression that resolves into an integer value.  A statement is
    Xterminated by an end-of-line or a semicolon.  The following translations
    Xare also performed.
    X
    X        <       .lt.    <=      .le.
    X        ==      .eq.
    X        !=      .ne.    ^=      .ne.    ~=      .ne.
    X        >=      .ge.    >       .gt.
    X        |       .or.    &       .and.
    X        !       .not.   ^       .not.   ~       .not.
    X
    XInteger constants in bases other that decimal may be specified as
    Xn%dddd...  where n is a decimal number indicating the base and dddd...
    Xare digits in that base.  For bases > 10, letters are used for digits
    Xabove 9.  Examples:  8%77, 16%2ff, 2%0010011.  The number is converted
    Xthe equivalent decimal value using multiplication; this may cause sign
    Xproblems if the number has too many digits.
    X
    XString literals ("..." or '...') can be continued across line boundaries
    Xby ending the line to be continued with an underline.  The underline is
    Xnot included as part of the literal.  Leading blanks and tabs on the
    Xnext line are ignored; this facilitates consistent indentation.
    X
    X        include file
    X
    Xwill include the named file in the input.
    X
    X        define (name,value)     or
    X        define name value
    X
    Xdefines name as a symbolic parameter with the indicated value.  Names of
    Xsymbolic parameters may contain letters, digits, periods, and underline
    Xcharacter but must begin with a letter (e.g.  B.FLAG).  Upper case is
    Xnot equivalent to lower case in parameter names.
    X
    X        string name "character string"          or
    X        string name(size) "character string"
    X
    Xdefines name to be an integer array long enough to accomodate the ascii
    Xcodes for the given character string, one per word.  The last word of
    Xname is initialized to the symbolic parameter EOS, and indicates the end
    Xof string.
SHAR_EOF
if test 2471 -ne "`wc -c < 'ratfor.doc'`"
then
    echo shar: error transmitting "'ratfor.doc'" '(should have been 2471 characters)'
fi
chmod +x 'ratfor.doc'
fi # end of overwriting check
echo shar: extracting "'test.r'" '(366 characters)'
if test -f 'test.r'
then
    echo shar: will not over-write existing file "'test.r'"
else
sed 's/^    X//' << \SHAR_EOF > 'test.r'
    Xinteger x,y
    Xx=1; y=2
    Xif(x == y)
    X    write(6,600)
    Xelse if(x > y)
    X    write(6,601)
    Xelse
    X    write(6,602)
    Xx=1
    Xwhile(x < 10){
    X    if(y != 2) break
    X    if(y != 2) next
    X    write(6,603)x
    X    x=x+1
    X    }
    Xrepeat
    X    x=x-1
    Xuntil(x == 0)
    Xfor(x=0; x < 10; x=x+1)
    X    write(6,604)x
    X600 format('Wrong, x != y')
    X601 format('Also wrong, x < y')
    X602 format('Ok!')
    X603 format('x = ',i2)
    X604 format('x = ',i2)
    Xend
SHAR_EOF
if test 366 -ne "`wc -c < 'test.r'`"
then
    echo shar: error transmitting "'test.r'" '(should have been 366 characters)'
fi
chmod +x 'test.r'
fi # end of overwriting check
echo shar: extracting "'makefile'" '(488 characters)'
if test -f 'makefile'
then
    echo shar: will not over-write existing file "'makefile'"
else
sed 's/^    X//' << \SHAR_EOF > 'makefile'
    X# pd ratfor (oz)
    X#
    X# if F77 is defined, the output
    X# of ratfor is Fortran 77.
    X#
    XCFLAGS = -DF77 -O
    XDEST = /usr/local/bin
    XOBJS = rat4.o lookup.o getopt.o
    XCSRC = rat4.c lookup.c getopt.c
    XHSRC = ratdef.h ratcom.h lookup.h
    XDOCS = README ratfor.doc
    XRSRC = test.r makefile
    X
    Xrat4:    ${OBJS}
    X    cc -o ratfor ${OBJS}
    X
    Xrat4.o:        ratdef.h ratcom.h
    Xlookup.o:    lookup.h
    X
    Xinstall: rat4
    X    install ./ratfor ${DEST}/ratfor
    Xclean:
    X    rm -f *.o core ratfor
    Xpack:
    X    shar -a ${CSRC} ${HSRC} ${DOCS} ${RSRC} >RATFOR.SHAR
SHAR_EOF
if test 488 -ne "`wc -c < 'makefile'`"
then
    echo shar: error transmitting "'makefile'" '(should have been 488 characters)'
fi
chmod +x 'makefile'
fi # end of overwriting check
#    End of shell archive